home *** CD-ROM | disk | FTP | other *** search
/ Extra Heft 12 / Extra Heft12.bin / input64 / 05_86.d64 / editor .lsp < prev    next >
Text File  |  1995-08-17  |  4KB  |  126 lines
  1. (NX EXPR (LAMBDA NIL (COND ((ATOM (
  2. CDR CLU))) (T (SETQ CLU (CDR CLU)) (
  3. SETQ CL (CAR CLU))))))
  4. (FIND EXPR (LAMBDA (L I X W) (COND ((
  5. ATOM L) NIL) ((MEMBER I (CAR L)) (
  6. LIST X)) ((SETQ W (FIND (CAR L) I 1)) 
  7. (CONS X W)) (T (FIND (CDR L) I (ADD1 
  8. X))))))
  9. (FI FEXPR (NLAMBDA (I) (MAPC (QUOTE G)
  10.  (FIND CL I 1 NIL)) (P)))
  11. (B FEXPR (NLAMBDA L (RPLACA CLU (SETQ 
  12. CL (CONC L (CAR CLU)))) (BACK)) VALUE 
  13. (A B (C D E) F G))
  14. (: FEXPR (NLAMBDA (L) (RPLACA CLU (
  15. SETQ CL L))))
  16. (LO EXPR (LAMBDA (X Y Z) (SETQ Z (NTH 
  17. CL (H X))) (SETQ Y (NTH CL (H (SUB1 X)
  18. ))) (COND ((CONSP (CAR Z)) (RPLACD Y (
  19. CAR Z))))))
  20. (LI EXPR (LAMBDA (X) (BI X -1)))
  21. (R FEXPR (NLAMBDA (X Y) (REPL X Y CL))
  22. )
  23. (REPL EXPR (LAMBDA (X Y L) (COND ((
  24. ATOM L) NIL) ((EQUAL (CAR L) X) (
  25. RPLACA L Y) (REPL X Y (CDR L))) ((
  26. EQUAL (CDR L) X) (RPLACD L Y)) (T (
  27. REPL X Y (CAR L)) (REPL X Y (CDR L))))
  28. ))
  29. (RO EXPR (LAMBDA (X Y) (COND ((NULL Y)
  30.  (SETQ Y (LENGTH CL)))) (SETQ X (NTH 
  31. CL (H X))) (SETQ Y (NTH CL (H Y))) (
  32. RPLACA X (CONC (CAR X) (CDR X))) (
  33. RPLACD X (CDR Y)) (RPLACD Y NIL)))
  34. (BO EXPR (LAMBDA (X) (SETQ X (NTH CL (
  35. H X))) (SETQ Y (CONC (CAR X) (CDR X)))
  36.  (RPLACA X (CAR Y)) (RPLACD X (CDR Y))
  37. ))
  38. (BI EXPR (LAMBDA (X Y) (COND ((NULL Y)
  39.  (SETQ Y X))) (SETQ X (NTH CL (H X))) 
  40. (SETQ Y (NTH CL (H Y))) (SETQ Z (CDR 
  41. Y)) (RPLACD Y NIL) (RPLACA X (CONS (
  42. CAR X) (CDR X))) (RPLACD X Z)))
  43. (RI EXPR (LAMBDA (X Y) (SETQ X (NTH 
  44. CL (H X))) (SETQ Y (NTH (CAR X) (H Y))
  45. ) (SETQ Z (CDR X)) (RPLACD X (CDR Y)) 
  46. (CONC (CDR Y) Z) (RPLACD Y NIL)))
  47. (EXPT EXPR (LAMBDA (X Y) (COND ((EQ Y 
  48. 0) 1) (T (TIMES X (EXPT X (SUB1 Y)))))
  49. ))
  50. (E FEXPR (NLAMBDA (L) (PRINT (EVAL L))
  51. ) VALUE (NLAMBDA (L) (PRINT (EVAL L)))
  52. )
  53. (_ EXPR (LAMBDA NIL (SETQ CLU (LAST 
  54. TR)) (SETQ TR (LIST CLU)) (SETQ CL (
  55. CAR CLU))))
  56. (N FEXPR (NLAMBDA L (CONC CL L)))
  57. (A FEXPR (NLAMBDA L (RPLACD CLU (CONC 
  58. L (CDR CLU))) (BACK)) VALUE (NLAMBDA 
  59. L (RPLACD CLU (CONC L (CDR CLU))) (
  60. BACK)))
  61. (CONC EXPR (LAMBDA (L1 L2) (COND ((
  62. ATOM L1) L2) ((ATOM L2) L1) (T (NCONC 
  63. L1 L2)))))
  64. (DEL EXPR (LAMBDA (X L) (SETQ X (H X))
  65.  (COND ((ATOM CL) CL) ((ZEROP X) (
  66. RPLACA CLU (SETQ CL (CONC L CL)))) ((
  67. EQ X 1) (RPLACA CLU (SETQ CL (CONC L (
  68. CDR CL))))) (T (RPLACD (NTH CL (SUB1 
  69. X)) (CONC L (NTH CL (ADD1 X))))))))
  70. (UNDO EXPR (LAMBDA NIL (SETQ LIS (
  71. COPY OLD)) (SETQ CLU (LIST LIS)) (
  72. SETQ TR (LIST CLU)) (SETQ CL (CAR CLU)
  73. )))
  74. (OUT EXPR (LAMBDA NIL (SAVE 8 
  75. "@0:EDITOR.LSP" EDFNS)))
  76. (ADD FEXPR (NLAMBDA L (COND ((ATOM L) 
  77. EDFNS) (T (SETQ EDFNS (CONS (CAR L) 
  78. EDFNS)) (APPLY (QUOTE ADD) (CDR L)))))
  79. )
  80. (P@ EXPR (LAMBDA NIL (PP CL)))
  81. (BACK EXPR (LAMBDA NIL (COND ((ATOM (
  82. CDR TR)) CL) (T (SETQ CLU (CAR TR)) (
  83. SETQ TR (CDR TR)) (SETQ CL (CAR CLU)))
  84. )))
  85. (G EXPR (LAMBDA (X) (SETQ X (H X)) (
  86. COND ((ZEROP X) (BACK)) ((GREATERP X (
  87. LENGTH CL)) CL) (T (SETQ TR (CONS CLU 
  88. TR)) (SETQ CLU (NTH CL X)) (SETQ CL (
  89. CAR CLU))))))
  90. (P EXPR (LAMBDA NIL (PRINT (P& CL))) 
  91. VALUE (LAMBDA NIL (PRINT (P& CL))))
  92. (P& EXPR (LAMBDA (L) (COND ((ATOM L) 
  93. L) (T (CONS (P& (CAR L)) (MAPCAR (
  94. QUOTE (LAMBDA (X) (COND ((ATOM X) X) (
  95. T (QUOTE &))))) (CDR L)))))))
  96. (H EXPR (LAMBDA (X) (COND ((MINUSP X) 
  97. (SETQ X (ABS (PLUS 1 X (LENGTH CL)))))
  98. ) (COND ((GREATERP X (LENGTH CL)) (
  99. LENGTH CL)) (T X))))
  100. (EDFNS VALUE (NX FIND FI B : LO LI R 
  101. REPL RO BO BI RI EXPT E _ N A CONC 
  102. DEL UNDO OUT ADD P@ BACK G P P& H 
  103. EDFNS EDIT EDITF EDITV EDITP))
  104. (EDIT EXPR (LAMBDA (L) (PROG (OLD TR 
  105. CL CLU E X LIS) (SETQ OLD L) (SETQ 
  106. LIS (COPY L)) (SETQ CLU (LIST LIS)) (
  107. SETQ TR (LIST CLU)) (SETQ CL (CAR CLU)
  108. ) (P) LOOP1 (MSG "*ED*: ") (SETQ E (
  109. READL)) LOOP2 (COND ((ATOM E) (GO 
  110. LOOP1))) (SETQ X (CAR E)) (COND ((
  111. NUMBERP X) (G X)) ((EQ X (QUOTE OK)) (
  112. RETURN (CAR (LAST TR)))) ((EQ X (
  113. QUOTE PP)) (PP CL)) ((ATOM X) (EVAL (
  114. LIST X))) ((NUMBERP (CAR X)) (DEL (
  115. CAR X) (CDR X))) (T (EVAL X))) (SETQ 
  116. E (CDR E)) (GO LOOP2))))
  117. (EDITF FEXPR (NLAMBDA (F L) (COND ((
  118. SETQ L (APPLY (QUOTE GETDEF) (LIST F))
  119. ) (EVAL (CONS (CAR L) (CONS (CADR L) (
  120. EDIT (CDDR L)))))))))
  121. (EDITV FEXPR (NLAMBDA (F) (SET F (
  122. EDIT (EVAL F)))))
  123. (EDITP FEXPR (NLAMBDA (A P) (PUTPROP 
  124. A P (EDIT (GETPROP A P)))))
  125. NIL
  126.